home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / turbcomm.arc / REDEFINE.INC < prev    next >
Text File  |  1989-06-30  |  9KB  |  232 lines

  1.  
  2.    Const
  3.       Redefinables : set of FunKeyCode =
  4.                     [Help,KDo,Interrupt,Resume,Cancel,Main,KExit,
  5.                      Options,F17,F18,F19,F20,Find,Insert,Remove,
  6.                      Select,Prev,Next,PF1,PF2,PF3,PF4];
  7.  
  8.    Var
  9.       FunctionKeyChanged : Boolean;
  10.  
  11.    Function MakeDisplayable(InputStr : STR80) : STR80;
  12.       { Return a screen displayable version of the input string }
  13.       Var
  14.          CharCount : Byte;
  15.          TempString : STR80;
  16.       Begin
  17.          TempString := '';
  18.          For CharCount := 1 to Length(InputStr) Do
  19.             If InputStr[CharCount] < ' '
  20.                Then TempString := TempString + '^'
  21.                                      + Chr(Ord(InputStr[CharCount])+64)
  22.                Else TempString := TempString + InputStr[CharCount];
  23.  
  24.          MakeDisplayable := TempString;
  25.          End; { Function MakeDisplayable }
  26.  
  27.  
  28.    Procedure RedefineKey(Key : FunKeyCode);
  29.       { Append keyboard input to key definition until <F4> is pressed }
  30.       Const
  31.          DispOfs = 18;
  32.       Var
  33.          NewString : STR80;
  34.          DisplayString,OldVideoLine : String[160];
  35.  
  36.       Begin
  37.          FunctionKeyChanged := True;
  38.          DisplayString := '';
  39.          NewString := '';
  40.          FunCode := DUM4;
  41.          OldVideoLine := GetVidLine(24);  { Save what was on the 24th line }
  42.          Write(SaveCursor);
  43.          GotoXY(1,24);
  44.          Write('Enter Definition:');
  45.          ClrEol;
  46.  
  47.          While (FunCode <> F4) And (Length(DisplayString) < (80 - DispOfs)) Do
  48.             Begin
  49.                Repeat Until ReadKey;
  50.                Case FunCode Of
  51.                   DUM4:   If InString = Chr(127) { Delete Key }
  52.                              Then Begin
  53.                                 NewString := Copy(NewString,1,
  54.                                    Length(NewString) - 1);
  55.                                 DisplayString := MakeDisplayable(NewString);
  56.                                 End
  57.                              Else NewString := NewString + InString;
  58.                   F4:     InString := '';
  59.                   Else    Begin
  60.                              InString := GetInitFunkey(FunCode);
  61.                              NewString := NewString + InString;
  62.                              End;
  63.                   End; { Case statement }
  64.  
  65.                GotoXY(Length(DisplayString) + DispOfs,24);
  66.                If InString = Chr(127)
  67.                   Then ClrEol
  68.                   Else Begin
  69.                      Write(MakeDisplayable(Instring));
  70.                      DisplayString := DisplayString +
  71.                         MakeDisplayable(InString);
  72.                      End;
  73.  
  74.                End; { While statement }
  75.  
  76.          FunKeys[Key] := NewString;
  77.          GotoXY(1,24);
  78.          ClrEol;
  79.          NormVideo;
  80.          Write('Ok');
  81.          LowVideo;
  82.          GotoXY(1,24);
  83.          Delay(1000);
  84.          ClrEol;
  85.          Write(OldVideoLine);  { Restore what was on the 24th line }
  86.          Write(RestoreCursor);
  87.          End; { Procedure RedefineKey }
  88.  
  89.  
  90.    Procedure ReadKeyFile;
  91.       { Read in function key redefinitions from the file }
  92.       Label NoKeyFile;
  93.  
  94.       Type
  95.          FunctionKeyRec = Record
  96.                            KeyNum : FunKeyCode;
  97.                            KeyLen : Byte;
  98.                            KeyStr : String[80];
  99.                            End;
  100.       Var
  101.          FileVar : File of FunctionKeyRec;
  102.          FunKeyRec : FunctionKeyRec;
  103.          FileLine : STR80;
  104.          TempCode : FunKeyCode;
  105.          I : Integer;
  106.       Begin
  107.          FunctionKeyChanged := False;  { Initialize as false }
  108.  
  109.            { Get Function key directory name from MS-DOS environmental variable }
  110.          { FKey_Dir defined as typed constant in main program }
  111.            GetEnvParam(FKey_Dir,FKey_Dir);
  112.            If FKey_Dir > '' Then
  113.               If FKey_Dir[Length(FKey_Dir)] <> '\'
  114.                  Then FKey_Dir := FKey_Dir + '\';
  115.  
  116.          Assign(FileVar,FKey_Dir+KeyFileName+'.KEY');
  117.          {$I-}  Reset(FileVar);  {$I+}
  118.  
  119.          If IOResult <> 0 Then
  120.             Begin
  121.                Goto NoKeyFile;
  122.                End;
  123.  
  124.          While not Eof(FileVar) Do
  125.             Begin
  126.                Read(FileVar,FunKeyRec);
  127.                With FunKeyRec Do
  128.                   Begin
  129.                      FileLine := '';
  130.                      For I := 1 to KeyLen Do
  131.                         FileLine := FileLine + KeyStr[I];
  132.                      FunKeys[KeyNum] := FileLine;
  133.                      End; { With statement }
  134.                End; { While not end of the file }
  135.             
  136.          Close(FileVar);
  137.          NoKeyFile:  { There was not key file to be read }
  138.          End; { Procedure ReadKeyFile }
  139.  
  140.  
  141.    Procedure WriteKeyFile;
  142.       { Write out NON-DEFAULT function key definitions to file }
  143.       Label NoKeyChanges;          
  144.       
  145.       Const
  146.          BadNewFileName : Boolean = True;
  147.                         
  148.       Type
  149.          FunctionKeyRec = Record
  150.                            KeyNum : FunKeyCode;
  151.                            KeyLen : Byte;
  152.                            KeyStr : String[80];
  153.                            End;
  154.       Var                  
  155.          NewFileName : STR80;                                 
  156.          FileExtPos : Byte;
  157.          FileVar : File of FunctionKeyRec;
  158.          FunKeyRec : FunctionKeyRec;
  159.          SaveQuery : Char;
  160.          FunCount : FunKeyCode;
  161.          I : Integer;
  162.  
  163.       Begin
  164.          SaveQuery := ' ';
  165.  
  166.          If FunctionKeyChanged  { Check if they want to save changes }
  167.             Then
  168.                Begin
  169.                   NormVideo;
  170.                   Writeln;
  171.                   Write('Do you want to save the new function key ');
  172.                   Write('definitions? [Y/N] <Y> ');
  173.                   Repeat
  174.                      Read(Kbd,SaveQuery);
  175.                      Until SaveQuery In ['Y','y','N','n',^M];
  176.                   Writeln;
  177.                   If SaveQuery In ['N','n'] Then
  178.                      Begin
  179.                         Writeln('Not saving new definitions.');
  180.                         Goto NoKeyChanges;
  181.                         End { If they don't want to save }
  182.                      Else 
  183.                         Begin
  184.                            While BadNewFileName Do
  185.                               Begin
  186.                                  LowVideo;
  187.                                  Write('Save to file <');
  188.                                  NormVideo;
  189.                                  Write(KeyFileName);
  190.                                  LowVideo;
  191.                                  Write('> :');
  192.                                  Readln(NewFileName);
  193.                                  Writeln;
  194.                                  FileExtPos := Pos('.',NewFileName);
  195.                                  If Length(NewFileName) > 0
  196.                                     Then If FileExtPos > 0
  197.                                        Then KeyFileName := Copy(NewFileName,
  198.                                           1,FileExtPos - 1)
  199.                                        Else KeyFileName := NewFileName;
  200.    { Modification for V2.21 - FKey_Dir }
  201.                                  Assign(FileVar,FKey_Dir+KeyFileName+'.KEY');
  202.                                  {$I-} Rewrite(FileVar); {$I+}
  203.                                  If IOResult <> 0
  204.                                     Then Write('Bad file name! ',
  205.                                             'No extension allowed!')
  206.                                     Else BadNewFileName := False;
  207.                                  End; { While the new filename was bad }
  208.                               Writeln('Saving new definitions.');
  209.                            End;
  210.                   End { There were changes }
  211.             Else Goto NoKeyChanges;  { There were no changes to save }
  212.  
  213.          For FunCount := Help to Break Do
  214.             If FunCount In Redefinables
  215.                Then If FunKeys[FunCount] <> GetInitFunkey(FunCount)
  216.                      Then { The definition is not the default value }
  217.                         Begin
  218.                            With FunKeyRec Do
  219.                               Begin
  220.                                  KeyNum := FunCount;
  221.                                  KeyLen := Length(FunKeys[FunCount]);
  222.                                  KeyStr := FunKeys[FunCount];
  223.                                  End;
  224.                            Write(FileVar,FunKeyRec);
  225.                            End; { If this definition should be written }
  226.  
  227.          Close(FileVar);
  228.          NoKeyChanges: LowVideo;
  229.          End; { Procedure WriteKeyFile }
  230.  
  231.  
  232.